home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #119 (1991-03)(Amiga User Group Deutschland e.V.).zip
/
Franz PD Disk #119 (1991-03)(Amiga User Group Deutschland e.V.).adf
/
AmigaBASIC_Programme
/
Mathetest
< prev
next >
Wrap
Text File
|
1989-07-03
|
12KB
|
218 lines
'Mathematik-Test !
'© 1988 by Michael Gottwald
Start: SCREEN 1,640,256,3,2:WINDOW 1,"",(0,0)-(630,200),8,1
MC: DEFINT o,w:DIM o(42),w(256):FOR i=0 TO 42:READ o(i):NEXT
FOR i=0 TO 255:w(i)=-128+i:NEXT:WAVE 0,w:WAVE 1,w:WAVE 2,w:WAVE 3,w
PALETTE 0,.6,.5,.3:PALETTE 1,.6,.5,.3:PALETTE 2,1,1,1:PALETTE 3,1,1,0
PALETTE 4,.6,0,0:PALETTE 5,0,1,0:PALETTE 6,0,0,.8:PALETTE 7,.36,.24,0
WINDOW 1:LOCATE 2,31:COLOR 2:PRINT"MATHEMATIK-TEST":COLOR 3,0
PRINT:PRINT"Trainieren Sie Ihr Kopfrechnen in den 4 Grundrechenarten mit ";
PRINT"dem AMIGA ganz":PRINT"ungezwungen mit diesem Programm."
PRINT"Der Test kann völlig individuell eingestellt werden.Dazu dienen ";
PRINT"die Menü-":PRINT"funktionen:":COLOR 4
PRINT"* SCHWIERIGKEITSGRAD: Die Größe der Zahl ergibt die maximal zulässi";
PRINT"gen Dezimal-":PRINT"stellen; bei 4 also Zahlen bis 9999,bei 2 können ";
PRINT"Zahlen bis 99 auftreten.":COLOR 5:PRINT
PRINT"* FLIEßKOMMAZAHLEN JA/NEIN: Sollen Fließkommazahlen (Ja) oder nur ";
PRINT"ganze Zahlen":PRINT"(Nein) verwendet werden ...?":COLOR 6:PRINT
PRINT"* GEMISCHTE AUFGABEN / NUR EINE GRUNDRECHENART: Sollen die Testauf";
PRINT"gaben in":PRINT"allen 4 oder nur in einer Grundrechenart gestellt ";
PRINT"werden ...?":COLOR 7:PRINT
PRINT"* ANZAHL DER TESTAUFGABEN: Die Anzahl der Testaufgaben,die gestellt";
PRINT" und ausge-":PRINT"wertet werden sollen.":COLOR 3:PRINT
PRINT"...ESC drücken,wenns losgehen kann...":COLOR 2,6:LOCATE 23,23
PRINT" © 1988 by Michael Gottwald ":COLOR ,0:Code&=VARPTR(o(0))
CALL Code&
bMenu: CLS:COLOR 2,7:PRINT"»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«»« MENÜ ";
PRINT"»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«»«":COLOR 3,0:PRINT
PRINT"* Schwierigkeitsgrad":PRINT:PRINT"* Fließkommazahlen":PRINT
PRINT"* Anzahl der Testaufgaben":PRINT:PRINT"*"
FOR i=14 TO 46 STEP 16:LINE (214,i)-(250,i+12),6,b:NEXT:COLOR 4
LINE (380,54)-(430,84),2,bf:LINE (380,86)-(430,116),2,bf
LINE (326,86)-(376,116),2,bf:LINE (434,86)-(484,116),2,bf:COLOR 7
AREA (390,56):AREA STEP (4,2):AREA STEP (-4,0):AREA STEP (0,16)
AREA STEP (-1,0):AREA STEP (0,-16):AREA STEP (-4,0):AREA STEP (4,-2)
AREAFILL:AREA (390,106):AREA STEP (4,-2):AREA STEP (-4,0):AREA STEP (0,-16)
AREA STEP (-1,0):AREA STEP (0,16):AREA STEP (-4,0):AREA STEP (4,2)
AREAFILL:AREA (330,90):AREA STEP (4,-2):AREA STEP (0,5):AREA STEP (-5,-3)
AREA STEP (34,0):AREAFILL:AREA (470,90):AREA STEP (-4,-2):AREA STEP (0,5)
AREA STEP (5,-3):AREA STEP (-34,0):AREAFILL:PSET (380,54),0:PSET (430,54),0
PSET (380,84),0:PSET (430,84),0:FOR i=326 TO 434 STEP 54:PSET (i,86),0
PSET STEP (50,0),0:PSET STEP (0,30),0:PSET STEP (-50,0),0:NEXT:COLOR 6
LOCATE 13,34:PRINT"Wählen":LOCATE 13,63:PRINT"Wählen":LOCATE 6,47
PRINT"Pfeil 'rauf":LOCATE 16,47:PRINT"Pfeil 'runter":COLOR 7
LOCATE 20,2:PRINT"Drücken Sie F10 zum starten des Tests..."
PRINT:PRINT"...Und ESC zum beenden des Programms...":k=12577793&
x=254:y=20:lv=2:fl=1:t=1:q=4:COLOR 4:GOSUB pAll:GOSUB Arrow
Select: c=PEEK(k):IF c=103 AND y>20 THEN GOSUB clr:y=y-16:GOSUB Arrow
IF c=101 AND y<68 THEN GOSUB clr:y=y+16:GOSUB Arrow
IF c=77 THEN GOTO Begin
IF c=117 THEN END
IF c=97 OR c=99 THEN
IF y=20 AND c=97 AND lv>1 THEN lv=lv-1:GOSUB Level
IF y=20 AND c=99 AND lv<6 THEN lv=lv+1:GOSUB Level
IF y=36 THEN fl=fl XOR 1:GOSUB Float
IF y=52 AND c=97 AND q>1 THEN q=q-1:GOSUB Quantity
IF y=52 AND c=99 AND q<99 THEN q=q+1:GOSUB Quantity
IF y=68 THEN t=t XOR 1:GOSUB Task
END IF
GOTO Select
Begin: i=lv:j=fl:l=q:CLS:IF fl=0 THEN
PRINT"Wieviele Stellen hinter dem Komma (maximal 16 !) ?"
Number: INPUT"Bitte ";s:IF s<1 OR s>16 THEN Number
DEFDBL a-h,m,n
END IF
IF fl=1 THEN DEFINT a,b,c,e-h,m,n-s,u-z
lv=i:fl=j:q=l:CLS:LINE (245,0)-(246,8),3,b:LINE (245,0)-(261,8),3
LINE (246,0)-(262,8),3:LINE (277,0)-(278,8),3,b:LOCATE 1,36:COLOR 3
LINE (262,8)-(278,0),3:LINE (261,8)-(277,0),3:LINE (277,8)-(386,8),3
PRINT"athematiktest":z=1:y=8:FOR i=0 TO 135 STEP 27:z=z+1:y=y-1
LINE (i,z)-(i+100,15-z),y,bf:LINE (639-i,z)-(539-i,15-z),y,bf:NEXT
IF t=0 THEN sl=1:GOTO Mixed
LINE (56,48)-(572,123),2,bf:LINE (56,56)-(572,56),0:COLOR 4,2
LOCATE 7,30:PRINT"U n t e r m e n Ü":COLOR 6:LOCATE 9,10
PRINT"A d d i t i o n ............... x + y ";:COLOR 5,7
PRINT" F1 drücken ":LOCATE 11,10:COLOR 6,2
PRINT"S u b t r a k t i o n ......... x - y ";:COLOR 5,7
PRINT" F2 drücken ":LOCATE 13,10:COLOR 6,2
PRINT"M u l t i p l i k a t i o n ... x · y ";:COLOR 5,7
PRINT" F3 drücken ":LOCATE 15,10:COLOR 6,2
PRINT"D i v i s i o n ............... x : y ";:COLOR 5,7
PRINT" F4 drücken ":w=0:r=0:tr=0
Fk: k$=INKEY$:IF k$=CHR$(129) THEN GOSUB UMoff:GOSUB Addition:GOTO Finish
IF k$=CHR$(130) THEN GOSUB UMoff:GOSUB Subtraktion:GOTO Finish
IF k$=CHR$(131) THEN GOSUB UMoff:GOSUB Multiplikation:GOTO Finish
IF k$=CHR$(132) THEN GOSUB UMoff:GOSUB Division:GOTO Finish
GOTO Fk
Mixed: FOR z=1 TO q:GOSUB UMoff
ON sl GOSUB Addition,Subtraktion,Multiplikation,Division
LINE (0,16)-(639,150),0,bf:sl=sl+1:IF sl=5 THEN sl=1
NEXT:GOTO Finish
SUB polygon STATIC
SHARED r1,r2,c
x=320:y=100:d=.628318:FOR i=0 TO 6.28318 STEP d
LINE (x+COS(i)*r1,y+SIN(i)*r2)-(x+COS(i+d)*r1,y+SIN(i+d)*r2),c:NEXT
PAINT (x,y),c,c
END SUB
Finish: COLOR 2,0:CLS:c=7:FOR r1=200 TO 150 STEP -10
r2=r1/2-20:polygon:c=c-1:NEXT:r2=r2-5:polygon:LOCATE 9,1:COLOR 6
PRINT PTAB(244)"Anzahl der falschen":PRINT PTAB(280)"Antworten:"
COLOR 3:LOCATE 12,1:sp=(LEN(STR$(tr))+1)*8:PRINT PTAB((640-sp)/2)tr
LOCATE 14,30:COLOR 2:PRINT"Note: ";:IF tr>0 THEN pr=tr/q*100
IF tr>=q THEN PRINT"Ungenügend !":GOTO GetAnswer
IF pr>=75 THEN PRINT"Mangelhaft !":GOTO GetAnswer
IF pr>=50 THEN PRINT"Ausreichend...":GOTO GetAnswer
IF pr>=35 THEN PRINT"Befriedigend...":GOTO GetAnswer
IF pr>=20 THEN PRINT"Gut/Befriedigend...":GOTO GetAnswer
IF pr>=10 THEN PRINT"Gut...":GOTO GetAnswer
IF pr>=5 THEN PRINT"Sehr gut/Gut !":GOTO GetAnswer
IF tr=0 THEN PRINT"Sehr gut !"
GetAnswer: k$=INKEY$:LOCATE 16,26:COLOR 7:PRINT"<ESC> = Ende <F10> = Neustart"
k$=INKEY$:IF k$=CHR$(27)THEN END
IF k$=CHR$(138)THEN RUN
GOTO GetAnswer
UMoff: LINE (56,48)-(572,123),0,bf:RETURN
PrName: COLOR 3,7:l=LEN(a$):FOR i=1 TO l:LOCATE l-i+3,i+2:PRINT" ";
PRINT MID$(a$,i,1);" ":LOCATE i+2,75-l+i:PRINT" ";MID$(a$,i,1);" "
NEXT:x=l*8:y=16+x:LINE (x,16)-(630-x,16),7:LINE (0,y)-(41,y),7
LINE -(x+33,24),7:LINE -(630-x-32,24),7:LINE -(590,y),7
LINE -(639,y),7:LINE (x,16)-(0,y),7:LINE (630-x,16)-(630,y),7
PAINT (x,21),7:PAINT (300,21),7:PAINT (630-x,21),7:COLOR 4,0
LOCATE 5,20:PRINT"Level:";lv;" ...";:IF fl=1 THEN PRINT"Kein ";
PRINT"Fließkommaformat":LOCATE 7,18:PRINT"Aufgaben insgesamt:";
PRINT q;" Nachkommastellen:";s:LOCATE 9,33:COLOR 2,6
PRINT"Aufgabe Nr.":RETURN
Addition: a$="Addition":GOSUB PrName:IF t=1 THEN FOR i=1 TO q
GOSUB Ntask:GOSUB Numbers:n$=STR$(VAL(n1$)+VAL(n2$))
IF fl=0 THEN n$=STR$(VAL(n$)/10^s)
GOSUB Cut:e$=n$:GOSUB Set:PRINT"Was ist "n1$"+"n2$" ?"
GOSUB Result:LOCATE 15,12:PRINT SPACE$(44):IF t=1 THEN NEXT
RETURN
Subtraktion: a$="Subtraktion":GOSUB PrName:IF t=1 THEN FOR i=1 TO q
GOSUB Ntask:GOSUB Numbers:WHILE VAL(n1$)<VAL(n2$)
GOSUB Numbers:WEND:n$=STR$(VAL(n1$)-VAL(n2$))
IF fl=0 THEN n$=STR$(VAL(n$)/10^s)
GOSUB Cut:e$=n$:GOSUB Set
PRINT"Was ist "n1$"-"n2$" ?":GOSUB Result:LOCATE 15,12
PRINT SPACE$(44):IF t=1 THEN NEXT
RETURN
Multiplikation: a$="Multiplikation":GOSUB PrName:IF t=1 THEN FOR i=1 TO q
GOSUB Ntask:GOSUB Numbers:n$=STR$(VAL(n1$)*VAL(n2$))
IF fl=0 THEN n$=STR$(VAL(n$)/10^(s*2))
GOSUB Cut:e$=n$:GOSUB Set:PRINT"Was ist "n1$"·"n2$" ?"
GOSUB Result:LOCATE 15,12:PRINT SPACE$(44):IF t=1 THEN NEXT
RETURN
Division: a$="Division":GOSUB PrName:IF t=1 THEN FOR i=1 TO q
GOSUB Ntask:GOSUB Numbers
IF fl=1 THEN
WHILE VAL(n1$)/VAL(n2$)<>INT(VAL(n1$)/VAL(n2$))
GOSUB Numbers:WEND
END IF
n$=STR$(VAL(n1$)/VAL(n2$))
GOSUB Cut:e$=n$:GOSUB Set:PRINT"Was ist "n1$":"n2$" ?"
GOSUB Result:LOCATE 15,12:PRINT SPACE$(44):IF t=1 THEN NEXT
RETURN
Cut: IF fl=1 THEN IF LEFT$(n$,1)=" " THEN n$=MID$(n$,2):RETURN
n$=MID$(n$,2):pp=1:WHILE pp<=LEN(n$) AND MID$(n$,pp,1)<>"."
pp=pp+1:WEND:IF LEN(n$)>pp+s THEN n$=LEFT$(n$,pp+s)
RETURN
Set: IF fl=0 THEN
n1$=STR$(VAL(n1$)/10^s):n2$=STR$(VAL(n2$)/10^s)
n$=n1$:GOSUB Cut:n1$=n$:n$=n2$:GOSUB Cut:n2$=n$
END IF
RETURN
Result: LOCATE 14,12:COLOR 7:PRINT SPACE$(20):LOCATE 14,12
INPUT"Bitte ";ip$:LOCATE 15,12
IF LEN(ip$)>LEN(e$) THEN ip$=LEFT$(ip$,LEN(e$))
IF fl=0 AND s>1 AND VAL(RIGHT$(ip$,1))+1=VAL(RIGHT$(e$,1)) THEN t=1
IF fl=0 AND s>1 AND VAL(RIGHT$(ip$,1))-1=VAL(RIGHT$(e$,1)) THEN u=1
IF t=1 OR u=1 THEN MID$(ip$,LEN(ip$),1)=RIGHT$(e$,1)
IF ip$=e$ THEN Right
PRINT"Falsch !!! ...Auf ein Neues...":tr=tr+1:fr=150:saw:GOTO Result
Right: COLOR 3:PRINT"Richtig ! ...ESC zum weitermachen drücken !"
Code&=VARPTR(o(0)):POKE Code&+7,159:POKE Code&+45,159:CALL Code&
RETURN
Numbers: RANDOMIZE TIMER:m=10^lv-2:n1=1+RND*m:n2=1+RND*n1:IF n1=1 THEN n2=1
n$=STR$(n1):GOSUB Cut:n1$=n$:n$=STR$(n2):GOSUB Cut:n2$=n$
IF fl=0 THEN n1$=STR$(VAL(n1$)*10^s):n2$=STR$(VAL(n2$)*10^s)
RETURN 'Wegen mangelnder Rechenungenauigkeit in seltenen Fällen
'die Rechnung mit ganzen Zahlen durchfhren...
'(Komma um die Anzahl der Stellen nach rechts schieben !)
Ntask: LOCATE 9,44:COLOR 2,6:PRINT i:LOCATE 12,12:COLOR 2,0:RETURN
clr: LINE (254,14)-(276,74),0,bf:RETURN
pAll: GOSUB Level:GOSUB Float:GOSUB Task:GOSUB Quantity:RETURN
Level: LOCATE 3,29:PRINT" ":LOCATE 3,29:PRINT lv:RETURN
Float: LOCATE 5,28:PRINT" ":LOCATE 5,28:IF fl=0 THEN PRINT"Ja":RETURN
PRINT"Nein":RETURN
Quantity: LOCATE 7,29:PRINT" ":LOCATE 7,29
IF q<10 THEN PRINT q:RETURN ELSE LOCATE 7,28:PRINT q:RETURN
Task: LOCATE 9,3:IF t=0 THEN PRINT" Gemischte Aufgaben":RETURN
PRINT"Nur eine Grundrechenart":RETURN
Arrow: AREA (x,y):AREA STEP (10,-6):AREA STEP (0,4):AREA STEP (12,0)
AREA STEP (0,4):AREA STEP (-12,0):AREA STEP (0,4):AREA STEP (-10,-6)
COLOR 2:AREAFILL:COLOR 5:RETURN
SUB saw STATIC
SHARED fr:FOR i=0 TO 3:SOUND fr+i,8,255,i:SOUND WAIT:NEXT
SOUND RESUME
END SUB
DATA &h48e7,&hc080,&h0c39,&h003b,&h00df,&hf006,&h6700: 'Maschinenprogramm
DATA &h0014,&h0c39,&h0075,&h00bf,&hec01,&h6600,&hffea: 'zur Erzeugung des
DATA &h4cdf,&h0103,&h4e75,&h303c,&h0fff,&h323c,&h000f: 'farbigen Streifens
DATA &h343c,&h003b,&hb439,&h00df,&hf006,&h6600,&hfff8
DATA &h33c0,&h00df,&hf180,&h0440,&h0110,&h0642,&h0001
DATA &h51c9,&hffe6,&h33fc,&h0a85,&h00df,&hf180,&h6000
DATA &hffb0